module Damas where

import Char
import Tablero
import Maybe

data Juego = J Color Tablero
data Movimiento = M Posicion Direccion
  deriving Show

data Arbol a = Nodo a [Arbol a] deriving Show
type ArbolJugadas = Arbol ([Movimiento], Juego)

type Valuacion = Juego -> Double

---- Funciones de regalo ----

instance Show Juego where
  show (J turno tablero) = "\n--Juegan las " ++ show turno ++ "s--\n" ++ show tablero

arbolDeJugadas :: Juego -> ArbolJugadas
arbolDeJugadas j = Nodo ([], j) $ zipWith agmov movs hijos
  where agmov m (Nodo (ms, r) hs) = Nodo ((m:ms), r) (map (agmov m) hs)
        movsJuegos = movimientosPosibles j
        movs = map fst movsJuegos
        hijos = map (arbolDeJugadas . snd) movsJuegos

---- Ejercicios ----
color :: Ficha -> Color
color (Simple c) = c
color (Reina c) = c

isSimple :: Ficha -> Bool
isSimple (Simple c) = True
isSimple (Reina c) = False

destino :: Movimiento -> Posicion
destino (M (i,j) BR) = (chr ((ord i) + 1), j-1)
destino (M (i,j) BL) = (chr ((ord i) - 1), j-1)
destino (M (i,j) TR) = (chr ((ord i) + 1), j+1)
destino (M (i,j) TL) = (chr ((ord i) - 1), j+1)

destinoSiCaptura :: Movimiento -> Posicion
destinoSiCaptura (M (i,j) BR) = (chr ((ord i) + 2), j-2)
destinoSiCaptura (M (i,j) BL) = (chr ((ord i) - 2), j-2)
destinoSiCaptura (M (i,j) TR) = (chr ((ord i) + 2), j+2)
destinoSiCaptura (M (i,j) TL) = (chr ((ord i) - 2), j+2)


-- Ejercicio 3

dentroDelTablero :: Posicion -> Bool
dentroDelTablero (i, j) = i `elem` ['a'..'h'] && j `elem` [1..8]

-- se fija si hay ficha que comer y que sea del color contrario, detalle...
esCaptura :: Movimiento -> Tablero -> Color -> Bool
esCaptura (M (i, j) d) t c = not (isNothing (contenido (destino (M (i, j) d)) t)) && (color (dameFicha (contenido (destino (M (i, j) d)) t)) == (invertirColor c)) 

puedeMover :: Ficha -> Direccion -> Bool
-- las reinas pueden mover en cualquier direccion
puedeMover (Reina _) _ = True
-- las simples blancas no pueden ir para el bottom
puedeMover (Simple Blanca) TL = True
puedeMover (Simple Blanca) TR = True
puedeMover (Simple Blanca) _ = False
-- las simples negras no pueden ir para el top
puedeMover (Simple Negra) BL = True
puedeMover (Simple Negra) BR = True
puedeMover (Simple Negra) _ = False

invertirColor :: Color -> Color
invertirColor Blanca = Negra
invertirColor Negra = Blanca

-- renombro la funcion para aclarar!
fichaAComer :: Movimiento -> Posicion
fichaAComer = destino

-- funcion parcial!!
dameFicha :: Maybe Ficha -> Ficha
dameFicha (Just f) = f

-- corona si debe, segun su posicion destino
coronarSiSeDebe :: Ficha -> Posicion -> Ficha
coronarSiSeDebe (Simple Blanca) (x,y) = if y == 8 then (Reina Blanca) else (Simple Blanca)
coronarSiSeDebe (Simple Negra) (x,y) = if y == 1 then (Reina Negra) else (Simple Negra)
coronarSiSeDebe (Reina Blanca) _ = (Reina Blanca)
coronarSiSeDebe (Reina Negra) _ = (Reina Negra)

mover :: Movimiento -> Juego -> Maybe Juego
mover (M p d) (J c t) 
                -- la pos orig esta en el tablero
              | not (dentroDelTablero p) = Nothing 
                -- la posicion dest esta en el tablero (no captura)
              | not (dentroDelTablero (destino (M p d))) = Nothing               
                -- el contenido de la pos original no es vacio
              | contenido p t == Nothing = Nothing
                -- la posicion dest esta en el tablero (capturo)
              | (esCaptura (M p d) t c) && not (dentroDelTablero (destinoSiCaptura (M p d))) = Nothing 
                -- el color de la ficha tiene que ser el mismo del que le toca jugar
              | not (color (dameFicha (contenido p t)) == c) = Nothing
                -- chequea que pueda mover depende de que ficha es (Blanca, Negra, Simple o Reina)
              | not (puedeMover (dameFicha (contenido p t)) d) = Nothing
                -- el destino esta vacio (captura)
              | (esCaptura (M p d) t c) && not ((contenido (destinoSiCaptura (M p d)) t) == Nothing) = Nothing
                -- el destino esta vacio (no captura)
              | not (esCaptura (M p d) t c) && not ((contenido (destino (M p d)) t) == Nothing) = Nothing
                -- la ficha que capturo es la del color del rival
              | (esCaptura (M p d) t c) && (not (isNothing (contenido (destinoSiCaptura (M p d)) t))) && (color (dameFicha (contenido (destinoSiCaptura (M p d)) t)) == c) = Nothing
                -- sino, hago la movida
              | otherwise = 
                    (Just (J (invertirColor c) (if (esCaptura (M p d) t c) then
                    (sacar (fichaAComer (M p d)) (sacar p (poner (destinoSiCaptura (M p d))  (coronarSiSeDebe (dameFicha (contenido p t)) (destinoSiCaptura (M p d))) t)))
                    else
                    (sacar p (poner (destino (M p d)) (coronarSiSeDebe (dameFicha (contenido p t)) (destino (M p d))) t)))))


-- Ejercicio 4
movimientosPosibles :: Juego -> [(Movimiento, Juego)]
movimientosPosibles (J c t) = map (\(m, Just j) -> (m,j))  
					(filter (\(m, j1) -> not(isNothing j1))
					[(m, mover m (J c t) ) | 
					--itero todas las fichas de un color
					p<-(fichas t c),	
					--construyo un movimiento
					m<- [M p TL,  M p TR,  M p BL,  M p BR]
					]
					)

-- Ejercicio 5
foldArbol :: (a -> c -> b) -> ([b] -> c) -> Arbol a -> b
foldArbol g h (Nodo a xs) = g a (h (map (foldArbol g h) xs))

-- Ejercicio 6
podar :: Int -> Arbol a -> Arbol a
podar i a = podarP a i

podarP :: Arbol a -> Int -> Arbol a
podarP = foldArbol (\a xs n -> if (n == 0) then (Nodo a []) else (Nodo a (map (\x -> x (n-1)) xs))) (id)

-- Ejercicio 7
mejorMovimiento :: Valuacion -> ArbolJugadas -> Movimiento
mejorMovimiento v a = (head.snd) (minimax v a)

-- chooseF devuelve el x en la lista que decide el criterio f
chooseF :: (a -> a -> Bool) -> [a] -> a
chooseF f = foldr1 (\x y -> if f x y then x else y)

--Minimax con recursion explicita
--minimax2 v (Nodo a hs) = auxMinimax v (Nodo a hs) True
--
--auxMinimax :: Valuacion -> ArbolJugadas -> Bool -> (Double, [Movimiento])
--auxMinimax v (Nodo a []) _ = (v (snd a), fst a)
--auxMinimax v (Nodo _ hs) True = min0 (map (\x -> auxMinimax v x False) hs) 
--    where min0 = chooseF (\x y -> (fst x) < (fst y)) 
--auxMinimax v (Nodo _ hs) False = max0 (map (\x -> auxMinimax v x True) hs)
--    where max0 = chooseF (\x y -> (fst x) > (fst y))


minimax :: Valuacion -> ArbolJugadas -> (Double, [Movimiento])
minimax v = foldArbol f g
    where
        chooseMin = chooseF (\x y -> (fst x) < (fst y))
        chooseMax = chooseF (\x y -> (fst x) >= (fst y))
        g = \xs -> if (null xs) then Nothing else Just ( (chooseMin xs, chooseMax xs) )
        f = \j rec -> case rec of
            -- si es una hoja, devuelvo la jugada evaluada
            Nothing -> (v (snd j), fst j)
            -- sino elijo segun tengo que minimizar o maximizar la mejor jugada
            Just (minVal, maxVal) -> if (length (fst j) `mod` 2 == 0) then maxVal else minVal

-- Ejercicio 8
ganador :: Juego -> Maybe Color
ganador (J c t) | (length (movimientosPosibles (J c t)) == 0) = Just (invertirColor c)
		| (length (fichas t (invertirColor c)) == 0) = Just c
		| otherwise = Nothing

-- Ejercicio 9
valuacionDamas :: Juego -> Double
valuacionDamas (J c t)	| (ganador (J c t) == (Just c)) = 1
			| (ganador (J c t) == (Just (invertirColor c))) = -1
			| otherwise = fromIntegral (2 * (2 * r + s)) / fromIntegral ((2 * rtot + 2 * stot) - 1)
 where 	r = length (reinas t c)
	s = length (simples t c)
	rtot = r + (length (reinas t (invertirColor c)) )
	stot = s + (length (simples t (invertirColor c)) )


-- esta funcion se llama asi por que es corto el nombre pero devuelve todas las pocisiones ocupadas por un color
fichas :: Tablero -> Color -> [Posicion]
fichas t c = [ (i,j) | i <- ['a'..'h'], j <- [1..8], (not (isNothing (contenido (i,j) t))) && (color (dameFicha (contenido (i,j) t)) == c) ]

simples :: Tablero -> Color -> [Posicion]
simples t c = [ x | x <- (fichas t c), isSimple (dameFicha (contenido x t))]

reinas :: Tablero -> Color -> [Posicion]
reinas t c = [ x | x <- (fichas t c), not (isSimple (dameFicha (contenido x t)))]

